home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 11 / CU Amiga Magazine's Super CD-ROM 11 (1997)(EMAP Images)(GB)(Track 1 of 3)[!][issue 1997-06].iso / cucd / programming / oberonv4 / demos / mineselems.mod (.txt) < prev    next >
Oberon Text  |  1996-01-22  |  7KB  |  237 lines
  1. Syntax10.Scn.Fnt
  2. Syntax10b.Scn.Fnt
  3. FoldElems
  4. MODULE MinesElems; (** Oberon-MinesElem V1.32  (C) 1 Oct 95 by Ralf Degner *)
  5.     IMPORT
  6.         Texts, TextFrames, Mines, Oberon, Display, Printer, TextPrinter, Files;
  7.     TYPE
  8.         Elem = POINTER TO ElemDesc;
  9.         ElemDesc = RECORD (Texts.ElemDesc)
  10.             d: Mines.Data;
  11.         END;
  12.         Frame = POINTER TO FrameDesc;
  13.         FrameDesc = RECORD (Mines.FrameDesc)
  14.             col: INTEGER;
  15.             e: Elem;
  16.         END;
  17.         W: Texts.Writer;
  18.     (* print the element *)
  19.     PROCEDURE Print(e: Elem; x0, y0: INTEGER);
  20.         VAR
  21.             w, h: INTEGER;
  22.             FontName, Ausgabe: ARRAY 32 OF CHAR;
  23.     BEGIN
  24.         w:=SHORT(e.W DIV TextPrinter.Unit);
  25.         h:=SHORT(e.H DIV TextPrinter.Unit);
  26.         FontName:="Syntax16.Scn.Fnt";
  27.         Printer.ReplPattern(x0, y0, w, h, 2);
  28.         Printer.Line(x0, y0, x0+w, y0);
  29.         Printer.Line(x0, y0, x0, y0+h);
  30.         Printer.Line(x0+w, y0, x0+w, y0+h);
  31.         Printer.Line(x0, y0+h, x0+w, y0+h);
  32.         Ausgabe:="Oberon-Mines";
  33.         IF e.d.XKastenAnz<8 THEN FontName:="Syntax14.Scn.Fnt"; END;
  34.         Printer.String(x0+11, y0+h DIV 2-15, Ausgabe, FontName);
  35.     END Print;
  36.     (* draw all *)
  37.     PROCEDURE PlotAll(f: Frame);
  38.         VAR XDum, YDum: INTEGER;
  39.     BEGIN
  40.         Oberon.RemoveMarks(f.SeitenOffset, f.UntenOffset, f.W, f.H);
  41.         Display.ReplConst(f.col, f.SeitenOffset, f.UntenOffset, f.W-2, f.H-2, Display.replace);
  42.         FOR XDum:=1 TO f.d.XKastenAnz DO
  43.             FOR YDum:=1 TO f.d.YKastenAnz DO
  44.                 Mines.DrawKasten(f, XDum, YDum, FALSE, f.col)
  45.             END
  46.         END
  47.     END PlotAll;
  48.     (* create new field *)
  49.     PROCEDURE NewField(XAnz, YAnz, Quote, Mode: INTEGER): Mines.Data;
  50.         VAR d: Mines.Data;
  51.     BEGIN
  52.         NEW(d);
  53.         d.Aktiv:=TRUE; d.Pause:=FALSE; d.StartPlay:=FALSE;
  54.         d.XKastenAnz:=XAnz; d.YKastenAnz:=YAnz;
  55.         d.Quote:=Quote; d.Mode:=Mode;
  56.         Mines.NeuesFeld(d, d.XKastenAnz, d.YKastenAnz);
  57.         RETURN d;
  58.     END NewField;
  59.     (* do mouseaction for frame*)
  60.     PROCEDURE DoMouse(g: Mines.Frame; X, Y: INTEGER; Key, FirstKey: SET);
  61.         VAR
  62.             XKasten, YKasten: INTEGER;
  63.             f: Frame;
  64.     BEGIN
  65.         f:=g(Frame);
  66.         IF FirstKey={1} THEN
  67.             IF Key={1,0} THEN
  68.                 Mines.Score()
  69.             ELSIF Key={2,1} THEN
  70.                 IF (~f.d.Aktiv) OR (f.d.Aktiv & f.d.StartPlay) THEN
  71.                     f.d:=NewField(f.d.XKastenAnz, f.d.YKastenAnz, f.d.Quote, f.d.Mode);
  72.                     f.e.d:=f.d;
  73.                     PlotAll(f)
  74.                 END
  75.             ELSIF Key={1} THEN
  76.                 IF f.d.Aktiv & f.d.StartPlay THEN
  77.                     Texts.WriteString(W, "Mines to find: ");
  78.                     Texts.WriteInt(W, f.d.Mines, 1);
  79.                     Texts.WriteLn(W);
  80.                     Texts.Append(Oberon.Log, W.buf)
  81.                 END
  82.             END;
  83.             RETURN;
  84.         END;
  85.         X:=X-f.SeitenOffset;Y:=Y-f.UntenOffset;
  86.         IF X<0 THEN RETURN;END;
  87.         IF Y<0 THEN RETURN;END;
  88.         XKasten:=X DIV Mines.KastenPlatz +1;
  89.         YKasten:=Y DIV Mines.KastenPlatz +1;
  90.         IF (XKasten<=f.d.XKastenAnz) & (YKasten<=f.d.YKastenAnz) THEN
  91.             IF f.d.Aktiv THEN
  92.                 IF (X MOD Mines.KastenPlatz)=0 THEN RETURN;END;
  93.                 IF (Y MOD Mines.KastenPlatz)=0 THEN RETURN;END;
  94.                 Oberon.RemoveMarks(f.SeitenOffset, f.UntenOffset, f.W, f.H);
  95.                 Mines.MouseKeys(f, XKasten, YKasten, Key, FALSE, f.col);
  96.                 IF f.d.Count=0 THEN
  97.                     Texts.WriteString(W, "You've got it !  Time: ");
  98.                     Texts.WriteInt(W, f.d.Time, 1);
  99.                     Texts.WriteString(W, " sec.");
  100.                     Texts.WriteLn(W);
  101.                     Texts.Append(Oberon.Log, W.buf)
  102.                 END
  103.             END
  104.         END
  105.     END DoMouse;
  106.     (* handler for Frame *)
  107.     PROCEDURE FrameHandler(msgf: Display.Frame; VAR msg: Display.FrameMsg);
  108.         VAR f: Frame;
  109.     BEGIN
  110.         f:=msgf(Frame);
  111.         WITH msg: Oberon.InputMsg DO
  112.             IF msg.id=Oberon.track THEN
  113.                 f.UntenOffset:=f.Y+1;f.SeitenOffset:=f.X+1;
  114.                 Mines.TrackMouse(f, msg.X, msg.Y, msg.keys, DoMouse)
  115.             END
  116.         | msg: Mines.PlotKastenMsg DO
  117.             IF msg.d=f.d THEN
  118.                 Mines.DrawKasten(f, msg.x, msg.y, FALSE, f.col)
  119.             END
  120.         ELSE
  121.         END
  122.     END FrameHandler;
  123.     (* create new Frame *)
  124.     PROCEDURE NewFrame(d: Mines.Data; X0, Y0: INTEGER): Frame;
  125.         VAR f: Frame;
  126.     BEGIN
  127.         NEW(f);
  128.         f.handle:=FrameHandler; f.d:=d;
  129.         f.X:=X0; f.Y:=Y0;
  130.         f.W:=d.XKastenAnz*Mines.KastenPlatz+3;
  131.         f.H:=d.YKastenAnz*Mines.KastenPlatz+3;
  132.         f.SeitenOffset:=X0+1;f.UntenOffset:=Y0+1;
  133.         RETURN f;
  134.     END NewFrame;
  135.     (* load element state *)
  136.     PROCEDURE Load(e: Elem; VAR r: Files.Rider);
  137.         VAR XAnz, YAnz, Quote, Mode: SHORTINT;
  138.     BEGIN
  139.         Files.Read(r, XAnz);
  140.         Files.Read(r, YAnz);
  141.         Files.Read(r, Quote);
  142.         Files.Read(r, Mode);
  143.         e.d:=NewField(XAnz, YAnz, Quote, Mode);
  144.     END Load;
  145.     (* store element state *)
  146.     PROCEDURE Store(e: Elem; VAR r: Files.Rider);
  147.     BEGIN
  148.         Files.Write(r, SHORT(e.d.XKastenAnz));
  149.         Files.Write(r, SHORT(e.d.YKastenAnz));
  150.         Files.Write(r, SHORT(e.d.Quote));
  151.         Files.Write(r, SHORT(e.d.Mode));
  152.     END Store;
  153.     (* mouseaction, if not selected *)
  154.     PROCEDURE MouseAction(g: Mines.Frame; X, Y: INTEGER; keys, FirstKey: SET);
  155.     BEGIN
  156.         IF (keys={0,1}) OR (keys={1,2}) THEN Mines.Open()END
  157.     END MouseAction;
  158.     (* handler for element *)
  159.     PROCEDURE Handle(HanElem: Texts.Elem; VAR msg: Texts.ElemMsg);
  160.         VAR
  161.             copy: Elem;
  162.             e: Elem;
  163.             f: Frame;
  164.     BEGIN
  165.         e:=HanElem(Elem);
  166.         WITH msg: Texts.CopyMsg DO
  167.             NEW(copy); Texts.CopyElem(e, copy);
  168.             copy.d:=NewField(e.d.XKastenAnz, e.d.YKastenAnz, e.d.Quote, e.d.Mode);
  169.             msg(Texts.CopyMsg).e:=copy
  170.         | msg: Texts.IdentifyMsg DO
  171.             msg.mod:="MinesElems";
  172.             msg.proc:="Alloc"
  173.         | msg: TextFrames.DisplayMsg DO
  174.             IF ~msg.prepare THEN
  175.                 f:=NewFrame(e.d, msg.X0, msg.Y0);
  176.                 f.col:=msg.col;f.e:=e;
  177.                 PlotAll(f);
  178.                 msg.elemFrame:=f
  179.             END
  180.         | msg: TextFrames.TrackMsg DO
  181.             Mines.TrackMouse(f, msg.X, msg.Y, msg.keys, MouseAction)
  182.         | msg: TextPrinter.PrintMsg DO
  183.             IF ~msg.prepare THEN
  184.                 Print(e, msg.X0, msg.Y0)
  185.             END
  186.         | msg: Texts.FileMsg DO
  187.             IF msg.id=Texts.load THEN
  188.                 Load(e, msg.r)
  189.             ELSIF msg.id=Texts.store THEN
  190.                 Store(e, msg.r)
  191.             END
  192.         ELSE
  193.         END
  194.     END Handle;
  195.     (* build new element *)
  196.     PROCEDURE Build(Quote, XKasten, YKasten, Mode: INTEGER);
  197.         VAR
  198.             e: Elem;
  199.             M: TextFrames.InsertElemMsg;
  200.     BEGIN
  201.         Mines.GetPar(Quote, XKasten, YKasten, Mode);
  202.         NEW(e);
  203.         e.W:=LONG(XKasten*Mines.KastenPlatz+3)*TextFrames.Unit;
  204.         e.H:=LONG(YKasten*Mines.KastenPlatz+3)*TextFrames.Unit;
  205.         e.handle:=Handle; e.d:=NewField(XKasten, YKasten, Quote, Mode);
  206.         M.e:=e;
  207.         Oberon.FocusViewer.handle(Oberon.FocusViewer, M)
  208.     END Build;
  209.     (* allocator for loaded element *)
  210.     PROCEDURE Alloc*;
  211.         VAR e: Elem;
  212.     BEGIN
  213.         NEW(e);
  214.         e.handle:=Handle;
  215.         Texts.new:=e
  216.     END Alloc;
  217.     (* insert different elements *)
  218.     PROCEDURE Insert*;
  219.     BEGIN
  220.         Build(15, 8, 8, -1);
  221.     END Insert;
  222.     PROCEDURE Beginner*;
  223.     BEGIN
  224.         Build(15, 8, 8, 0);
  225.     END Beginner;
  226.     PROCEDURE Advanced*;
  227.     BEGIN
  228.         Build(16, 16, 16, 1);
  229.     END Advanced;
  230.     PROCEDURE Expert*;
  231.     BEGIN
  232.         Build(21, 30, 16, 2);
  233.     END Expert;
  234. BEGIN
  235.     Texts.OpenWriter(W)
  236. END MinesElems.
  237.